home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Plus 1995 #1
/
Amiga Plus 1995 #1.iso
/
fish-disketten
/
fish_921-930
/
d923
/
rawinsert
/
rawinsert.mod
< prev
next >
Wrap
Text File
|
1994-12-13
|
5KB
|
175 lines
(* --------------------------------------------------------------------------
:Program. RawInsert.mod
:Contents. Inserts text or other input events into the input stream
:Author. Franz Schwarz
:Copyright. Public Domain
:Language. Oberon-2
:Translator. Amiga Oberon 3.00
:History. v1.0 25-Jul-93 fSchwarz
:Address. Mühlenstraße 2, D-78591 Durchhausen, Germany / R.F.A.
:Address. uucp: Franz.Schwarz@mil.ka.sub.org; Fido: 2:241/7506.18
:Support. CxLib (replacement for Commodore's cx.lib), BlackMagic
:Remark. Amiga-Oberon 3.00 checks string pointers to be even if
:Remark. OddChk is enabled; thus don't compile with OddChk.
:Usage. "DELAY=MILLISECS=MS/K/N,DESCR=D/S,FROM=FILE/K,TEXT/F"
-------------------------------------------------------------------------- *)
MODULE RawInsert;
IMPORT
I: Intuition, inpe: InputEvent, co: Commodities, d: Dos, e: Exec,
t: Timer, cx: CxLib, a: ASCII, o: OberonLib, y: SYSTEM, b: BlackMagic;
CONST
defaultMicros = 2 * 1000;
chkStep = LONGSET{0..9};
verTag = "\000$VER: RawInsert 1.0 (25.7.93) (w) Franz.Schwarz@mil.ka.sub.org - PD";
templ = "DELAY=MILLISECS=MS/K/N,DESCR=D/S,FROM=FILE/K,TEXT/F";
TYPE
ArgsT = STRUCT
delay: UNTRACED POINTER TO LONGINT;
descr: LONGINT;
from : b.LStrPtr;
text : b.LStrPtr;
END;
VAR
mp : e.MsgPortPtr;
tr : t.TimeRequestPtr;
iep : inpe.InputEventPtr;
rda : d.RDArgsPtr;
Args : ArgsT;
fh,fh1 : d.FileHandlePtr;
i,lc : LONGINT;
micros : LONGINT;
devopn : BOOLEAN;
cb : ARRAY 2 OF CHAR;
ds : b.DynStrPtr;
ls : b.LStrPtr;
chkstep: LONGSET;
PROCEDURE CleanUp();
BEGIN
cx.FreeIEvents (iep);
IF ds # NIL THEN DISPOSE (ds); END;
IF fh1 # NIL THEN d.OldClose (fh1); END;
IF rda # NIL THEN d.FreeArgs (rda); END;
IF devopn THEN e.CloseDevice (tr); END;
IF tr # NIL THEN e.DeleteIORequest (tr); END;
IF mp # NIL THEN e.DeleteMsgPort (mp); END;
IF o.Result > d.warn THEN
IF o.wbStarted OR (d.dos.lib.version < 37) THEN
I.DisplayBeep (NIL);
ELSE
d.PrintF ("%s failed!\n", y.ADR (verTag [7]));
END;
END;
END CleanUp;
PROCEDURE Halt ();
BEGIN
o.HaltProc();
END Halt;
PROCEDURE PutIEvents (ie: inpe.InputEventPtr);
VAR
ie1: inpe.InputEventPtr;
BEGIN
WHILE ie # NIL DO
IF d.ctrlC IN d.CheckSignal (LONGSET{d.ctrlC}) THEN
y.SETREG (0, d.SetIoErr (d.break)); o.Result := d.fail; Halt();
END;
ie1 := ie.nextEvent;
ie.nextEvent := NIL;
co.AddIEvents (ie);
ie.nextEvent := ie1;
tr.time.secs := 0; tr.time.micro := micros;
tr.node.command := t.addRequest; e.OldDoIO (tr);
ie := ie.nextEvent;
END;
END PutIEvents;
PROCEDURE PutCh (ch: LONGINT);
BEGIN
cb[0] := CHR (ch);
iep := cx.InvertStringForwd (cb, NIL);
IF iep = NIL THEN o.Result := d.warn; END;
PutIEvents (iep);
cx.FreeIEvents (iep);
END PutCh;
BEGIN
o.Result := d.fail; micros := defaultMicros;
IF (co.base = NIL) OR (d.dos.lib.version < 37) OR o.wbStarted THEN Halt(); END;
mp := e.CreateMsgPort();
tr := e.CreateIORequest (mp, SIZE (tr^));
IF tr = NIL THEN Halt(); END;
devopn := e.OpenDevice (t.timerName, t.microHz, tr, LONGSET{}) = 0;
IF ~devopn THEN Halt(); END;
rda := d.ReadArgs (templ, Args, NIL);
IF rda = NIL THEN Halt(); END;
IF (Args.text # NIL) & (Args.from # NIL) THEN
y.SETREG (0, d.SetIoErr (d.tooManyArgs)); Halt();
END;
IF (Args.delay # NIL) THEN
IF (Args.delay^ < 0) OR (Args.delay^ > 999) THEN
y.SETREG (0, d.SetIoErr (d.badNumber)); Halt();
END;
micros := Args.delay^ * 1000;
END;
IF micros < 0 THEN Halt(); END;
IF Args.text # NIL THEN
ls := Args.text;
ELSE
IF Args.from # NIL THEN
fh1 := d.Open (Args.from^, d.oldFile); fh := fh1;
ELSE
fh := d.Input();
END;
IF fh = NIL THEN Halt(); END;
IF d.IsInteractive (fh) THEN chkstep := LONGSET {}; ELSE chkstep := chkStep; END;
i := 0;
REPEAT
IF y.VAL (LONGSET, i) * chkstep = LONGSET {} THEN
b.SetDynamicExtra (i+512);
IF d.ctrlC IN d.CheckSignal (LONGSET{d.ctrlC}) THEN
y.SETREG (0, d.SetIoErr (d.break)); Halt();
END;
END;
IF ~b.DynExpand (ds, i) THEN Halt(); END;
lc := d.FGetC (fh);
IF lc > 0 THEN
ds[i] := CHR (lc);
INC (i);
END;
UNTIL lc < 0;
ds[i] := '\000';
IF d.IoErr() # 0 THEN Halt(); END;
ls := b.StrIndex (ds^, 0);
END;
IF Args.descr # 0 THEN
iep := cx.InvertStringForwd (ls^, NIL);
IF iep = NIL THEN Halt() END;
PutIEvents (iep);
o.Result := d.ok;
ELSE
o.Result := d.ok; i := 0;
WHILE ls[i] # a.nul DO
PutCh (ORD (ls[i]));
INC (i);
END;
END;
CLOSE
CleanUp();
END RawInsert.